-- zs5/MyBinarysearch.hs
module MyBinarySearch where

-- =========================== 二分搜索是否存在
search1 :: (Ord a) => a -> [a] -> Bool
search1 a [] = False
search1 a xs
  | m < a = search1 a behind
  | m > a = search1 a front
  | otherwise = True
  where
    (front, m : behind) = splitAt (length xs `div` 2) xs

-- =========================== 二分搜索索引 1
srch2 a xs = _srch2 0 a xs

_srch2 base a [] = base
_srch2 base a xs
  | m < a = _srch2 (base + la + 1) a behind
  | m > a = _srch2 base a front
  | otherwise = base + la
  where
    n = length xs
    la = n `div` 2
    (front, m : behind) = splitAt la xs

{-
srch2 4 []
srch2 4 [1,2]
srch2 4 [1,2,4]
srch2 4 [4]
srch2 4 [4,5]
srch2 4 [1,4,5,6]
srch2 4 [1,2,3,4,5]
srch2 4 [1,2,4,4,4,5]
-}

-- =========================== 二分搜索索引
srch2b :: (Ord a) => a -> [a] -> [Int]
srch2b a xs = _srch2b 0 [] a xs

-- 输入
-- base xs的初始序号
-- ret 当前结果;
-- a xs; 要匹配的元素, 列表
_srch2b :: (Ord a) => Int -> [Int] -> a -> [a] -> [Int]
_srch2b base ret a [] = ret
_srch2b base ret a xs
  | a < m = _srch2b base ret a front -- 搜索前半段
  | a > m = _srch2b (base + la + 1) ret a behind -- 搜索后半段
  | otherwise = eA ++ ret' ++ eB
  where
    n = length xs -- 列表长度
    la = n `div` 2 -- 前半段, floor
    (front, m : behind) = splitAt la xs
    ret' = (base + la) : ret
    eA = _srch2b base [] a front
    eB = _srch2b (base + la + 1) [] a behind

{-
-- 测试
srch2b 4 []
srch2b 4 [1,2]
srch2b 4 [1,2,4]
srch2b 4 [4]
srch2b 4 [4,5]
srch2b 4 [1,4,5,6]
srch2b 4 [1,2,3,4,5]
srch2b 4 [1,2,4,4,4,5]
srch2b 4 [1,2,2,3,4,4,4,5,6,7,8]
-}

-- ===================== 寻找双侧边界, 0-based

lrBound a xs
  | l >= n = (-1, -1) -- 左边界 非法
  | r <= 0 = (-1, -1) -- 右边界 非法
  | otherwise = (l, r) --
  where
    n = length xs
    l = sLeft a xs
    r = sRight a xs

{-
-- 测试
lrBound 4 []
lrBound 4 [1,2]
lrBound 4 [1,2,4]
lrBound 4 [4]
lrBound 4 [4,5]
lrBound 4 [1,4,5,6]
lrBound 4 [1,4,4,4,5,6,7,8,9,9]
lrBound 4 [1,2,3,4,5]
lrBound 4 [1,2,4,4,4,5]
lrBound 4 [1,2,2,3,4,4,4,5,6,7,8]
-}

-- ++++++++++++++++++++ a 的左边界
sLeft a xs = _left 0 a xs

-- help 函数
_left base a [] = base
_left base a xs
  | a < m = _left base a front -- 继续搜索左边
  | a == m && isHere = base + la -- m 满足条件, 即为此处
  | a == m = _left base a iFront -- 继续搜索左边
  | otherwise = _left (base + la + 1) a behind -- 继续搜索右边
  where
    n = length xs -- 列表长度
    la = n `div` 2 -- 前半段长度; 下整; 可能为零
    (front, m : behind) = splitAt la xs
    isFrontNull = null front -- 此时 la ==0
    isHere = isFrontNull || isFrontLess -- 先判断是否为空
    fl = last front -- m左侧的值
    iFront = init front
    isFrontLess = fl < a -- m左侧值小于a

{-
sLeft 4 []
sLeft 4 [1,2]
sLeft 4 [1,2,4]
sLeft 4 [4]
sLeft 4 [4,5]
sLeft 4 [1,4,5,6]
sLeft 4 [1,2,3,4,5]
sLeft 4 [1,2,4,4,4,5]
sLeft 4 [1,2,2,3,4,4,4,5,6,7,8]
-}

-- ++++++++++++++++++++ a 的右边界
sRight a xs = _right 0 a xs

-- help 函数
_right base a [] = base
_right base a xs
  | a > m = _right (base + la + 1) a behind -- 继续搜索 右边
  | a == m && isHere = base + la + 1 -- m 满足条件
  | a == m = _right (base + la + 2) a iB
  | otherwise = _right base a front
  where
    n = length xs -- 列表长度
    la = n `div` 2 -- 前半段长度; 下整; 可能为零
    (front, m : behind) = splitAt la xs
    isBNull = null behind
    bl = head behind
    isBGrt = bl > a
    isHere = isBNull || isBGrt -- 先判断是否为空
    iB = tail behind

{-
--test
sRight 4 []
sRight 4 [1,2]
sRight 4 [1,2,4]
sRight 4 [4]
sRight 4 [4,5]
sRight 4 [1,4,5,6]
sRight 4 [1,2,3,4,5]
sRight 4 [1,2,4,4,4,5]
sRight 4 [1,2,2,3,4,4,4,5,6,7,8]
-}
